home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Original Shareware 1.1
/
The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso
/
19
/
madtrb11.zip
/
GETDIR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-08-05
|
4KB
|
119 lines
PROGRAM GetDir;
{
This program displays a directory for MS-DOS systems from within
a TURBO pascal program. The following MS-DOS function calls are used:
2F - Get Disk Transfer Address (DTA) in ES:BX
4E - Find first occurrance of file name at DS:DX
4F - Find next occurrance of file name at DS:DX
Source: "Displaying an MS-DOS Directory", TUG Lines Volume I Issue 6
Author: Scott Freeman/Detroit, MI
Application: PC-DOS, MS-DOS
}
type
DirStr = string[12];
regpack = record
ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
end;
var name1, name2 : dirstr;
found : boolean;
Procedure Find_DTA(VAR dtaseg,dtaofs : integer);
{ Find the address of the DTA with function 2F }
{ Both CP/M and Xenix style directory searches put results in the DTA }
var recpack : regpack;
begin
with recpack do begin
ax := $2F shl 8;
MsDos(recpack);
dtaseg := es;
dtaofs := bx;
end;
end;
Function Get_Filename_from_DTA : dirstr;
{ Extract the filename from the Data Transfer Area and return a string }
{ The name returned does NOT have a drive letter specification. }
var i, dtaseg, dtaofs : integer;
ch : char;
result : dirstr;
begin
find_DTA(dtaseg,dtaofs); { Where did MSDOS leave the name? }
result := ''; { Avoid sending old garbage back }
i := 30; { Name starts at position 30 of DTA }
ch := chr(mem[dtaseg:dtaofs+i]); { Get the first character }
while ch <> chr(0) do begin { Get characters until null found }
result := concat(result,ch);
i := i+1;
ch := chr(mem[dtaseg:dtaofs+i]); end;
get_filename_from_DTA := result;
end;
Procedure Dir_First( Source : dirstr; { Pattern to search for }
VAR Result : dirstr; { Entry found that matches }
VAR Found : boolean); { True if pattern matched }
var
recpack : regpack; {record for MSDOS call}
flg : byte;
begin
{ Add a terminating null so that it's an ASCIIZ string }
source := concat(source,chr(0));
with recpack do
begin
ax := $4E shl 8; { Call Xenix-like Directory First function }
ds := (seg(source));
dx := (ofs(source)+1); { Skip the length byte of a TURBO string }
end;
MsDOS(recpack);
result := ''; { Make the return string a null }
flg := recpack.flags AND 1; { Check to see if match was found }
if flg = 0 then begin { Found a match }
found := true;
result := Get_Filename_From_DTA;
end
else found := false; { No match found }
end;
Procedure Dir_Next( Source : dirstr; { Pattern to search for }
VAR Result : dirstr; { Entry found that matches }
VAR Found : boolean); { True if pattern matched }
{Calls to this procedure must be proceded by an initial call to Dir_First }
var
recpack : regpack; { record for MSDOS call }
flg : byte;
begin
{ Add a terminating null so that it's an ASCIIZ string }
source := concat(source,chr(0));
with recpack do
begin
ax := $4F shl 8; { Call Xenix-like Directory Next function }
ds := (seg(source));
dx := (ofs(source)+1); { Skip the length byte of a TURBO string }
end;
MsDOS(recpack);
result := ''; { Make the return string a null }
flg := recpack.flags AND 1; { Check to see if match was found }
if flg = 0 then begin { Found a match }
found := true;
result := Get_Filename_From_DTA;
end
else found := false; { No match found }
end;
begin { Main program - to test operation of directory procedures }
name1 := '*.*'; { Show all directory entries }
Dir_First(name1,name2,found);
if found then begin
writeln(name2);
repeat
Dir_Next(name1,name2,found);
if found then writeln(name2);
until NOT found;
end;
end. { Main }